 'by IMRUCOMING zhlcol14/04/15---------------------
 Sub 小复卷计划量分配()
 Range("j4").Select
 fjlcol = 9   '复卷量列number
 zhlcol = 23  '折合列number
 Total = 185 '每班折合量
 mm = 8 / 8 * 185 '中班8h
 
 For j = 1 To 2
 n1 = 0
 n2 = 0
 n3 = 0
 n4 = 0                       'n1,n2,n3,n4为日、中、夜、日班完成的复卷量
 rs = Cells(ActiveCell.Row, fjlcol).value    '该计划剩余复卷量
 rscal = Cells(ActiveCell.Row, zhlcol).value    '该计划剩余折合量
  m = 0
  
'白班开始分配
ActiveCell = rs
m = rscal
m0 = 0
k = 0
  Do While m < Total And k < 100   '防止无限循环
  ActiveCell.Offset(1, 0).Select
  k = k + 1
  m0 = m
  m = m + Cells(ActiveCell.Row, zhlcol).value
  ActiveCell = Cells(ActiveCell.Row, fjlcol).value
  rs = Cells(ActiveCell.Row, fjlcol).value
  If ActiveCell.value = 0 Then ActiveCell = ""
  Loop
ActiveCell = (Total - m0) / Cells(ActiveCell.Row, zhlcol).value * Cells(ActiveCell.Row, fjlcol).value
If ActiveCell.value = 0 Then ActiveCell = ""
rs = rs - ActiveCell.value
rscal = m - Total
ActiveCell.Offset(0, 1).Select
'白班安排完毕

  
'中班开始分配
ActiveCell = rs
m = rscal
m0 = 0
k = 0
  Do While m < mm And k < 100   '防止无限循环
  ActiveCell.Offset(1, 0).Select
  k = k + 1
  m0 = m
  m = m + Cells(ActiveCell.Row, zhlcol).value
  ActiveCell = Cells(ActiveCell.Row, fjlcol).value
  rs = Cells(ActiveCell.Row, fjlcol).value
  If ActiveCell.value = 0 Then ActiveCell = ""
  Loop
ActiveCell = (mm - m0) / Cells(ActiveCell.Row, zhlcol).value * Cells(ActiveCell.Row, fjlcol).value
If ActiveCell.value = 0 Then ActiveCell = ""
rs = rs - ActiveCell.value
rscal = m - mm
ActiveCell.Offset(0, 1).Select
'中班安排完毕

  
'夜班开始分配
ActiveCell = rs
m = rscal
m0 = 0
k = 0
  Do While m < Total And k < 100   '防止无限循环
  ActiveCell.Offset(1, 0).Select
  k = k + 1
  m0 = m
  m = m + Cells(ActiveCell.Row, zhlcol).value
  ActiveCell = Cells(ActiveCell.Row, fjlcol).value
  rs = Cells(ActiveCell.Row, fjlcol).value
  If ActiveCell.value = 0 Then ActiveCell = ""
  Loop
ActiveCell = (Total - m0) / Cells(ActiveCell.Row, zhlcol).value * Cells(ActiveCell.Row, fjlcol).value
If ActiveCell.value = 0 Then ActiveCell = ""
rs = rs - ActiveCell.value
rscal = m - Total
ActiveCell.Offset(0, 1).Select
'夜班安排完毕

ActiveCell = rs
m = rscal
Do While Cells(ActiveCell.Row, fjlcol).value <> 0 Or Cells(ActiveCell.Row, fjlcol).MergeArea.Rows.Count > 1
ActiveCell.Offset(1, 0).Select
ActiveCell = Cells(ActiveCell.Row, fjlcol).value
m = m + Cells(ActiveCell.Row, zhlcol).value
Loop
ActiveCell.Offset(0, 1) = Int(m)
ActiveCell.Offset(1, -3).Select
Next j
End Sub

 'by IMRUCOMING zhlcol20160724---------------------
 Sub PM6小复卷计划量分配()
 Range("j4").Select
 sizecol = 7 '规格列number
 fjlcol = 9   '复卷量列number
 zhlcol = 23  '折合列number
 Total = 180 '每班折合量
 sizechange = 5 / 60 / 8 * 180 '换规格时间
 
 mm = 8 / 8 * 180 '中班8h
 
 For j = 1 To 2
 n1 = 0
 n2 = 0
 n3 = 0
 n4 = 0                       'n1,n2,n3,n4为日、中、夜、日班完成的复卷量
 rs = Cells(ActiveCell.Row, fjlcol).value    '该计划剩余复卷量
 rscal = Cells(ActiveCell.Row, zhlcol).value    '该计划剩余折合量
 m = 0
 size = Cells(ActiveCell.Row, sizecol).value '该方案规格
  
'白班开始分配
ActiveCell = rs
m = rscal
m0 = 0
k = 0
  Do While m < Total And k < 100   '防止无限循环
  size = Cells(ActiveCell.Row, sizecol).value '该方案规格
  ActiveCell.Offset(1, 0).Select
  If Cells(ActiveCell.Row, fjlcol).value = 0 Then size = (size & (Cells(ActiveCell.Row, sizecol).value))
  If Cells(ActiveCell.Row, fjlcol).value <> 0 Then sizenow = Cells(ActiveCell.Row, sizecol).value '当前规格
  k = k + 1
  m0 = m
  m = m + Cells(ActiveCell.Row, zhlcol).value
  If sizenow <> size Then m = m + sizechange
  ActiveCell = Cells(ActiveCell.Row, fjlcol).value
  rs = Cells(ActiveCell.Row, fjlcol).value
  If ActiveCell.value = 0 Then ActiveCell = ""
  Loop
ActiveCell = (Total - m0) / Cells(ActiveCell.Row, zhlcol).value * Cells(ActiveCell.Row, fjlcol).value
If ActiveCell.value = 0 Then ActiveCell = ""
rs = rs - ActiveCell.value
rscal = m - Total
ActiveCell.Offset(0, 1).Select
'白班安排完毕

  
'中班开始分配
ActiveCell = rs
m = rscal
m0 = 0
k = 0
  Do While m < mm And k < 100   '防止无限循环
  size = Cells(ActiveCell.Row, sizecol).value '该方案规格
  ActiveCell.Offset(1, 0).Select
  If Cells(ActiveCell.Row, fjlcol).value = 0 Then size = (size & (Cells(ActiveCell.Row, sizecol).value))
  If Cells(ActiveCell.Row, fjlcol).value <> 0 Then sizenow = Cells(ActiveCell.Row, sizecol).value '当前规格
  k = k + 1
  m0 = m
  m = m + Cells(ActiveCell.Row, zhlcol).value
  If sizenow <> size Then m = m + sizechange
  ActiveCell = Cells(ActiveCell.Row, fjlcol).value
  rs = Cells(ActiveCell.Row, fjlcol).value
  If ActiveCell.value = 0 Then ActiveCell = ""
  Loop
ActiveCell = (mm - m0) / Cells(ActiveCell.Row, zhlcol).value * Cells(ActiveCell.Row, fjlcol).value
If ActiveCell.value = 0 Then ActiveCell = ""
rs = rs - ActiveCell.value
rscal = m - mm
ActiveCell.Offset(0, 1).Select
'中班安排完毕

  
'夜班开始分配
ActiveCell = rs
m = rscal
m0 = 0
k = 0
  Do While m < Total And k < 100   '防止无限循环
  size = Cells(ActiveCell.Row, sizecol).value '该方案规格
  ActiveCell.Offset(1, 0).Select
  If Cells(ActiveCell.Row, fjlcol).value = 0 Then size = (size & (Cells(ActiveCell.Row, sizecol).value))
  If Cells(ActiveCell.Row, fjlcol).value <> 0 Then sizenow = Cells(ActiveCell.Row, sizecol).value '当前规格
  k = k + 1
  m0 = m
  m = m + Cells(ActiveCell.Row, zhlcol).value
  If sizenow <> size Then m = m + sizechange
  ActiveCell = Cells(ActiveCell.Row, fjlcol).value
  rs = Cells(ActiveCell.Row, fjlcol).value
  If ActiveCell.value = 0 Then ActiveCell = ""
  Loop
ActiveCell = (Total - m0) / Cells(ActiveCell.Row, zhlcol).value * Cells(ActiveCell.Row, fjlcol).value
If ActiveCell.value = 0 Then ActiveCell = ""
rs = rs - ActiveCell.value
rscal = m - Total
ActiveCell.Offset(0, 1).Select
'夜班安排完毕

ActiveCell = rs
m = rscal
Do While Cells(ActiveCell.Row, fjlcol).value <> 0 Or Cells(ActiveCell.Row, fjlcol).MergeArea.Rows.Count > 1
ActiveCell.Offset(1, 0).Select
ActiveCell = Cells(ActiveCell.Row, fjlcol).value
m = m + Cells(ActiveCell.Row, zhlcol).value
Loop
ActiveCell.Offset(0, 1) = Int(m)
ActiveCell.Offset(1, -3).Select
Next j
End Sub
